home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / triton / examples / Palette.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-01-01  |  2.0 KB  |  76 lines
  1. PROGRAM Palette;
  2.  
  3. uses triton,tritonmacros,utility,vartags;
  4.  
  5. {
  6.   A demo in FPC Pascal using triton.library
  7.  
  8.   nils.sjoholm@mailbox.swipnet.se
  9. }
  10.  
  11.  
  12.  
  13. var
  14.   Triton_App : pTR_App;
  15.   Project : pTR_Project;
  16.   close_me : boolean;
  17.   trmsg : pTR_Message;
  18.   dummy : longint;
  19.  
  20.  
  21. begin
  22.  
  23.     Triton_App := TR_CreateApp(TAGS(
  24.                      TRCA_Name,longstr('Triton Palette Demo'),
  25.                      TRCA_Release,longstr('1'),
  26.                      TRCA_Date,longstr('03-06-1998'),
  27.                      TAG_DONE));
  28.  
  29.     if Triton_App <> nil then begin
  30.       ProjectStart;
  31.       WindowID(1);
  32.       WindowTitle('Palette');
  33.          HorizGroupA;
  34.             Space;
  35.             VertGroupA;
  36.                Space;
  37.                CenteredTextID('_Palette',7);
  38.                Space;
  39.                PaletteGadget(1,7);
  40.                Space;
  41.             EndGroup;
  42.             Space;
  43.          EndGroup;
  44.       EndProject;
  45.  
  46.   Project := TR_OpenProject(Triton_App,@tritontags);
  47.     IF Project <> NIL THEN BEGIN
  48.       close_me := FALSE;
  49.       WHILE NOT close_me DO BEGIN
  50.         dummy := TR_Wait(Triton_App,0);
  51.         REPEAT
  52.           trmsg := TR_GetMsg(Triton_App);
  53.           IF trmsg <> NIL THEN BEGIN
  54.             IF (trmsg^.trm_Project = Project) THEN BEGIN
  55.                CASE trmsg^.trm_Class OF
  56.                  TRMS_CLOSEWINDOW : begin
  57.                                        writeln('Your final colour was ',TR_GetValue(Project,7));
  58.                                        close_me := True;
  59.                                     end;
  60.                  TRMS_ERROR:        WriteLN(TR_GetErrorString(trmsg^.trm_Data));
  61.                  TRMS_NEWVALUE    : IF trmsg^.trm_ID = 7 then writeln('You picked colour ',trmsg^.trm_Data);
  62.                END;
  63.             END;
  64.             TR_ReplyMsg(trmsg);
  65.           END;
  66.         UNTIL close_me OR (trmsg = NIL);
  67.       END;
  68.      TR_CloseProject(Project);
  69.    end;
  70.    TR_DeleteApp(Triton_App);
  71.    END ELSE writeln('Can''t create Application',20);
  72. end.
  73.  
  74.  
  75.  
  76.